cvs.tcl

TKCVS Source Code For CVS。

#
# Tcl Library for TkCVS
#

# 
# Contains procedures used in interaction with CVS.
#

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

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

#
#  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]
  
  if {! [file isdirectory $cvscfg(tmpdir)]} {
    gen_log:log F "MKDIR $cvscfg(tmpdir)"
    file mkdir $cvscfg(tmpdir)
  }
  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]
  gen_log:log T "RETURN $cvscfg(tmpdir)/cvstmpdir.$pid"
  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]
  set cwd [pwd]
  gen_log:log T "ENTER ($mcode $filenames)"
  
  cd [file join $cvscfg(tmpdir) cvstmpdir.$pid $mcode]
  set commandline "$cvs log $filenames"
  gen_log:log C "$commandline"
  set ret [catch {eval "exec $commandline"} view_this]
  if {$ret} {
    cd $cwd
    cvsfail $view_this .merge
    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 "
    }
  }
  cd $cwd
  gen_log:log T "LEAVE"
  return $keepers
}

proc cvs_workdir_status {} {
  global cvscfg
  global cvs
  global Filelist

  gen_log:log T "ENTER"

  set cmd(cvs_status) [exec::new "$cvs -n -q status -l"]
  set status_lines [split [$cmd(cvs_status)\::output] "\n"]
  if {$cvscfg(econtrol)} {
    set cmd(cvs_editors) [exec::new "$cvs -n -q editors -l"]
    set editors_lines [split [$cmd(cvs_editors)\::output] "\n"]
  }
  if {$cvscfg(cvslock)} {
    set cmd(cvs_lockers) [exec::new "$cvs log"]
    set lockers_lines [split [$cmd(cvs_lockers)\::output] "\n"]
  }
  if {[info exists cmd(cvs_status)]} {
    # gets cvs status in current directory only, pulling out lines that include
    # Status: or Sticky Tag:, putting each file's info (name, status, and tag)
    # into an array.

    catch {unset cmd(cvs_status)}
    foreach logline $status_lines {
      if {[string match "File:*" $logline]} {
        regsub -all {\t+} $logline "\t" logline
        set line [split [string trim $logline] "\t"]
        gen_log:log D "$line"
        # Should be able to do these regsubs in one expression
        regsub {File: } [lindex $line 0] "" filename
        regsub {\s*$} $filename "" filename
        #if {[string match "no file *" $filename]} {
          #regsub {^no file } $filename "" filename
        #}
        regsub {Status: } [lindex $line 1] "" status
        set Filelist($filename:status) $status
        # Don't set editors to null because we'll use its presence
        # or absence to see if we need to re-read the repository when
        # we ask to map the editors column
        #set Filelist($filename:editors) ""
      } elseif {[string match "*Working revision:*" $logline]} {
        regsub -all {\t+} $logline "\t" logline
        set line [split [string trim $logline] "\t"]
        gen_log:log D "$line"
        set revision [lindex $line 1]
        regsub {New .*} $revision "New" revision
        set date [lindex $line 2]
        # The date field is not supplied to remote clients.
        if {$date == "" || [string match "New *" $date ] || \
            [string match "Result *" $date]} {
          ; # Leave as is
        } else {
          set juliandate [clock scan $date -gmt yes]
          set date [clock format $juliandate -format $cvscfg(dateformat)]
          set Filelist($filename:date) $date
        }
        set Filelist($filename:wrev) $revision
        set Filelist($filename:status) $status
      } elseif {[string match "*Sticky Tag:*" $logline]} {
        regsub -all {\t+} $logline "\t" logline
        set line [split [string trim $logline] "\t"]
        gen_log:log D "$line"
        set tagline [lindex $line 1]
        set t0 [lindex $tagline 0]
        set t1 [lrange $tagline 1 end]
        set stickytag ""
        if { $t0 == "(none)" } {
          set stickytag " on trunk"
        } elseif {[string match "(branch:*" $t1 ]} {
          regsub {\(branch: (.*)\)} $t1 {\1} t1
          set stickytag " on $t0  branch"
        } elseif {[string match "(revision:*" $t1 ]} {
          set stickytag " $t0"
        }
        set Filelist($filename:stickytag) "$revision $stickytag"
      } elseif {[string match "*Sticky Options:*" $logline]} {
        regsub -all {\t+} $logline "\t" logline
        set line [split [string trim $logline] "\t"]
        gen_log:log D "$line"
        set option [lindex $line 1]
        set Filelist($filename:option) $option
      }
    }
  }

  if {[info exists cmd(cvs_editors)]} {
    set filename {}
    catch {unset cmd(cvs_editors)}
    foreach logline $editors_lines {
      set line [split $logline "\t"]
      gen_log:log D "$line"
      set ell [llength $line]
      # ? files will show up in cvs editors output under certain conditions
      if {$ell < 5} {
        continue
      }
      #if there is no filename, then this is a continuation line
      set f [lindex $line 0]
      if {$f == {}} {
        append editors ",[lindex $line 1]"
      } else {
        if {$filename != {}} {
          set Filelist($filename:editors) $editors
        }
        set filename $f
        set editors [lindex $line 1]
      }
      gen_log:log D " $filename   $editors"
    }
    if {$filename != {}} {
      set Filelist($filename:editors) $editors
    }
  }

  if {[info exists cmd(cvs_lockers)]} {
    set filename {}
    set lockers {}
    catch {unset cmd(cvs_lockers)}
    foreach line $lockers_lines {
      if {[string match "Working file: *" $line]} {
        gen_log:log D "$line"
        regsub "Working file: " $line "" filename
      }
      if {[string match "*locked by:*" $line]} {
        gen_log:log D "$line"
        if {$filename != {}} {
          set p [lindex $line 4]
          set r [lindex $line 1]
          set p [string trimright $p {;}]
          gen_log:log D " $filename   $p\($r\)"
          append Filelist($filename:editors) $p\($r\)
        }
      }
    }
  }
  gen_log:log T "LEAVE"
}

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)"
  if {! $incvs} {
    cvs_notincvs
    return 1
  }
  set filelist [join $args]

  set success 1
  set faillist ""
  foreach file $filelist {
    file delete -force -- $file
    gen_log:log F "DELETE $file"
    if {[file exists $file]} {
      set success 0
      append faillist $file
    }
  }
  if {$success == 0} {
    cvsfail "Remove $file failed" .workdir
    return
  }

  set cmd [exec::new "$cvs remove $filelist"]
  if {$cvscfg(auto_status)} {
    $cmd\::wait
    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!" .workdir
    return 
  } else {
    set mess "This will remove the contents of these directories:\n\n"
    foreach file $filelist {
      append mess "   $file\n"
    }  
  }
  
  set v [viewer::new "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 $v
      cd $awd
      gen_log:log F "CD [pwd]"

      set commandline "$cvs remove \"$file\""
      $v\::do "$commandline" 1 status_colortags
      $v\::wait
    }
  }

  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 edit \"$file\""
    gen_log:log C "$commandline"
    set ret [catch {eval "exec $commandline"} view_this]
    if {$ret != 0} {
      view_output::new "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 -n 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" .workdir
      gen_log:log T "LEAVE -- cvs unedit failed"
      return
    }

    set commandline "$cvs unedit \"$file\""
    gen_log:log C "$commandline"
    set ret [catch {eval "exec $commandline"} view_this]
    if {$ret != 0} {
      view_output::new "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"
  }
  # FIXME: If $all, it would be nice to process the output
  set v [viewer::new "CVS History"]
  $v\::do "$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"
    }  
  }

  if {$filelist == ""} {
    append filelist [glob -nocomplain $cvscfg(aster) .??*]
  }
  set cmd [exec::new "$cvs add $binflag $filelist"]
  if {$cvscfg(auto_status)} {
    $cmd\::wait
    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