workdir.tcl

TKCVS Source Code For CVS。

  gen_log:log T "ENTER ($args)"

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

  if { [ are_you_sure "This will delete these files from your local, working directory:\n" $filelist ] == 1 } {
    gen_log:log F "DELETE $filelist"
    eval file delete -force -- $filelist
    setup_dir
  }
  gen_log:log T "LEAVE"
}

proc are_you_sure {mess args} {
#
# General posting message
#
  global cvscfg

  gen_log:log T "ENTER ($mess $args)"

  set filelist [join $args]
  if {$cvscfg(confirm_prompt)} {
    append mess "\n"
    set indent "      "

    foreach item $filelist {
      if { $item != {} } {
        append mess " $indent"
        append mess " $item\n"
      }
    }
    append mess "\nAre you sure?"
    if {[cvsconfirm $mess .workdir] != "ok"} {
      gen_log:log T "LEAVE 0"
      return 0
    }
  }
  gen_log:log T "LEAVE 1"
  return 1
}

proc busy_start {w} {

  foreach widget [winfo children $w] {
    catch {$widget config -cursor watch}
  }
  update idletasks
}

proc busy_done {w} {

  foreach widget [winfo children $w] {
    catch {$widget config -cursor ""}
  }
}

proc workdir_print_file {args} {
  global cvscfg

  gen_log:log T "ENTER ($args)"

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

  set mess "This will print these files:\n\n"
  foreach file $filelist {
    append mess "   $file\n"
  }
  append mess "\nUsing $cvscfg(print_cmd)\n"
  append mess "\nAre you sure?"
  if {[cvsconfirm $mess .workdir] == "ok"} {
    set final_result ""
    foreach file $filelist {
      gen_log:log C "$cvscfg(print_cmd) \"$file\""
      catch { eval exec $cvscfg(print_cmd) \"$file\" } file_result
      if { $file_result != "" } {
        set final_result "$final_result\n$file_result"
      }
    }
    if { $final_result != "" } {
      view_output::new "Print" $final_result
    }
  }
  gen_log:log T "LEAVE"
}

proc cvsroot_check { dir } {
  global cvscfg
  global cvsglb

  gen_log:log T "ENTER ($dir)"

  foreach {incvs insvn inrcs} {0 0 0} {break}

  if {[file isfile [file join $dir CVS Root]]} {
    set incvs 1
    read_cvs_dir [file join $dir CVS]
  } elseif {[file isfile [file join $dir .svn entries]]} {
    set insvn 1
    read_svn_dir $dir
  } else {
    set rcsdir [file join $dir RCS]
    if {[file exists $rcsdir]} {
      set cvscfg(rcsdir) $rcsdir
      set inrcs 1
    } elseif {[llength [glob -nocomplain -dir $dir *,v]] > 0} {
      set inrcs 1
      set cvscfg(rcsdir) $dir
    } else {
      set cvscfg(rcsdir) ""
    }
  }

  if {$inrcs} {
    # Make sure we have rcs, and bag this (silently) if we don't   
    set command "rcs -V"
    gen_log:log C "$command"
    set ret [catch {eval "exec $command"} raw_rcs_log]
    if {$ret} {
       gen_log:log D "$raw_rcs_log"
       if [string match {*Unknown option:*} $raw_rcs_log] {
         # An old version of RCS, but it's here
         set inrcs 1
       } else {
         set inrcs 0
       }
    }
  }

  gen_log:log T "LEAVE ($incvs $insvn $inrcs)"
  return [list $incvs $insvn $inrcs]
}

proc nop {} {}

proc disabled {} {
  cvsok "Command disabled." .workdir
}

proc isCmDirectory { file } {
  #gen_log:log T "ENTER ($file)"
  switch -- $file  {
    "CVS"  -
    "RCS"  -
    ".svn"  -
    "SCCS" { set value 1 }
    default { set value 0 }
  }
  #gen_log:log T "LEAVE ($value)"
  return $value
}

# Get the files in the current working directory.  Use the file_filter
# values Add hidden files if desired by the user.  Sort them to match
# the ordering that will be returned by cvs commands (this matches the
# default ls ordering.).
proc getFiles { } {
  global cvscfg
  global cvsglb

  gen_log:log T "ENTER"
  set filelist ""

  # make sure the file filter is at least set to "*".
  if { $cvscfg(file_filter) == "" } {
    set cvscfg(file_filter) "* .svn"
  }

  # get the initial file list, including hidden if requested
  if {$cvscfg(allfiles)} {
    # get hidden as well
    foreach item $cvscfg(file_filter) {
      set filelist [ concat [ glob -nocomplain .$item $item ] $filelist ]
    }
  } else {
    foreach item $cvscfg(file_filter) {
      set filelist [ concat [ glob -nocomplain $item ] $filelist ]
    }
  }
  #gen_log:log D "filelist ($filelist)"

  # ignore files if requested
  if { $cvscfg(ignore_file_filter) != "" } {
    foreach item $cvscfg(ignore_file_filter) {
      # for each pattern
      if { $item != "*" } {
        # if not "*"
        while { [set idx [lsearch $filelist $item]] != -1 } {
          # for each occurence, delete
          catch { set filelist [ lreplace $filelist $idx $idx ] }
        }
      }
    }
  }

  # make sure "." is always in the list for 'cd' purposes
  if { ( [ lsearch -exact $filelist "." ] == -1 ) } {
    set filelist [ concat "." $filelist ]
  }

  # make sure ".." is always in the list for 'cd' purposes
  if { ( [ lsearch -exact $filelist ".." ] == -1 ) } {
    set filelist [ concat ".." $filelist ]
  }

  # sort it
  set filelist [ lsort $filelist ]

  # if this directory is under CVS and CVS is not in the list, add it. Its
  # presence is needed for later processing
  if { ( [ file exists "CVS" ] ) &&
       ( [ lsearch -exact $filelist "CVS" ] == -1 ) } {
    #puts "********* added CVS"
    catch { set filelist [ concat "CVS" $filelist ] }
  }

  set cvscfg(ignore_file_filter) $cvsglb(default_ignore_filter)
  gen_log:log T "return ($filelist)"
  return $filelist
}

proc log_toggle { } {
  global cvscfg

  if {$cvscfg(logging)} {
    gen_log:init
  } else {
    gen_log:quit
  }
}

proc exit_cleanup { force } {
  global cvscfg

  # Count the number of toplevels that are currently interacting
  # with the user (i.e. exist and are not withdrawn)
  set wlist {}
  foreach w [winfo children .] {
    if {[wm state $w] != {withdrawn}} {
      lappend wlist $w
    }
  }

  if {$force == 0 && [llength $wlist] != 0 \
    && $wlist != {.trace} && $wlist != {.bgerrorTrace}} {
      return
  }

  # If toplevel windows exist ask them to close gracefully if possible
  foreach w $wlist {
    # Except .trace!
    if {$w != {.trace}} {
      catch {$w.close invoke}
    } else {
      # Invoking trace's close turns off logging. We don't want that,
      # but we do want to save its geometry.
      if {[winfo exists .trace]} {
        set cvscfg(tracgeom) [wm geometry .trace]
      }
    }
  }

  save_options
  set pid [pid]
  gen_log:log F "DELETE $cvscfg(tmpdir)/cvstmpdir.$pid"
  catch {file delete -force [file join $cvscfg(tmpdir) cvstmpdir.$pid]}
  exit
}

proc save_options { } {
#
# Save the options which are configurable from the GUI
#
  global cvscfg
  global logcfg
  global bookmarks

  gen_log:log T "ENTER"

  # There are two kinds of options we can set
  set BOOLopts { allfiles auto_status confirm_prompt \
                 showstatcol showdatecol showeditcol auto_tag \
                 status_filter recurse logging blame_linenums}
  set STRGopts { file_filter ignore_file_filter clean_these \
                 printer rdetail ldetail log_classes lastdir \
                 workgeom modgeom loggeom tracgeom}

  # Plus the logcanvas options
  set LOGopts [concat [array names logcfg show_*] scale]

  # set this to current directory, so we'll add it to the menu next time
  if ([catch pwd]) {
    return
  }
  set cvscfg(lastdir) [pwd]

  # Save the list so we can keep track of what we've done
  set BOOLset $BOOLopts
  set STRGset $STRGopts
  set LOGset $LOGopts

  set optfile [file join $cvscfg(home) .tkcvs]
  set bakfile [file join $cvscfg(home) .tkcvs.bak]
  # Save the old .tkcvs file
  gen_log:log F "MOVE $optfile $bakfile"
  catch {file rename -force $optfile $bakfile}

  gen_log:log F "OPEN $optfile"
  if {[catch {set fo [open $optfile w]}]} {
    cvsfail "Cannot open $optfile for writing" .workdir
    return
  }
  gen_log:log F "OPEN $bakfile"

  if {! [catch {set fi [open $bakfile r]}]} {
    while { [eof $fi] == 0 } {
      gets $fi line
      set match 0
      if {[regexp {^#} $line]} {
        # Don't try to scan comments.
        #gen_log:log D "PASSING \"$line\""
        puts $fo "$line"
        continue
      } elseif {[string match "*set *bookmarks*" $line]} {
        # Discard old bookmarks
        continue
      } else {
        foreach opt $BOOLopts {
          if {! [info exists cvscfg($opt)]} { continue }
          if {[string match "*set *cvscfg($opt)*" $line]} {
            # Print it and remove it from the list
            gen_log:log D "REPLACING $line  w/ set cvscfg($opt) $cvscfg($opt)"
            puts $fo "set cvscfg($opt) $cvscfg($opt)"
            set idx [lsearch $BOOLset $opt]
            set BOOLset [lreplace $BOOLset $idx $idx]
            set match 1
            break
          }
        }
        if {[string match "*set *cvscfg(checkrecursive)*" $line]} {
          # This helps us recover from a problem left behind by tkcvs 7.2
          continue
        }
        foreach opt $STRGopts {
          if {! [info exists cvscfg($opt)]} { continue }
          if {[string match "*set *cvscfg($opt)*" $line]} {
            # Print it and remove it from the list
            gen_log:log D "REPLACING $line  w/ set cvscfg($opt) $cvscfg($opt)"
            puts $fo "set cvscfg($opt) \"$cvscfg($opt)\""
            set idx [lsearch $STRGset $opt]
            set STRGset [lreplace $STRGset $idx $idx]
            set match 1
            break
          }
        }
        foreach opt $LOGopts {
          if {! [info exists logcfg($opt)]} { continue }
          if {[string match "*set *logcfg($opt)*" $line]} {
            # Print it and remove it from the list
            gen_log:log D "REPLACING \"$line\"  w/ set logcfg($opt) \"$logcfg($opt)\""
            puts $fo "set logcfg($opt) \"$logcfg($opt)\""
            set idx [lsearch $LOGset $opt]
            set LOGset [lreplace $LOGset $idx $idx]
            set match 1
            break
          }
        }
        if {$match == 0} {
          # We didn't do a replacement
          gen_log:log D "PASSING \"$line\""
          # If we don't check this, we get an extra blank line every time
          # we save the file.  Messy.
          if {[eof $fi] == 1} { break }
          puts $fo "$line"
        }
      }
    }
    foreach mark [lsort [array names bookmarks]] {
      gen_log:log D "Adding bookmark \"$mark\""
      puts $fo "set \"bookmarks($mark)\" \"$bookmarks($mark)\""
    }

    close $fi
  }

  # Print what's left over
  foreach opt $BOOLset {
    if {! [info exists cvscfg($opt)]} { continue }
    gen_log:log D "ADDING cvscfg($opt) $cvscfg($opt)"
    puts $fo "set cvscfg($opt) $cvscfg($opt)"
  }

  foreach opt $STRGset {
    if {! [info exists cvscfg($opt)]} { continue }
    gen_log:log D "ADDING cvscfg($opt) \"$cvscfg($opt)\""
    puts $fo "set cvscfg($opt) \"$cvscfg($opt)\""
  }

  foreach opt $LOGset {
    if {! [info exists logcfg($opt)]} { continue }
    gen_log:log D "ADDING logcfg($opt) \"$logcfg($opt)\""
    puts $fo "set logcfg($opt) \"$logcfg($opt)\""
  }

  close $fo
  ::picklist::save
  gen_log:log T "LEAVE"
}