#
# TCL Library for tkcvs
#

#
# $Id: workdir.tcl,v 1.39 1995/11/22 00:54:01 davide Exp $
#
# Current working directory display.  Handles all of the functions
# concerned with navigating about the current directory on the main
# window.
#

# Note that the mark canvas no longer exists in this revision of the
# code.  This is because Tk 4.0 supports non-adjacent selections in
# listbox widgets, and so the code is no longer necessary.  It still
# exists on a development branch in case it is needed later.

set indexPrefix "^"
set filenamePrefix "!"

proc workdir_setup {} {
  global cwd
  global module_dir
  global cvscfg
  global TOOLTIPS_OFF
  global local_bitmapdir
  global feedback

  frame .top -relief groove -border 2
  frame .cleft     
  frame .center
  frame .cright    
  frame .crbottom  
  frame .clbottom  
    
  frame .top_left  
  frame .top_right 
  frame .bottom 
  frame .bottom1 -relief groove -border 2
  frame .bottom2 -relief groove -border 2
  frame .bottom1label
  frame .bottom2label
  frame .bottom1workspace
  frame .bottom2workspace
    
  pack .top                           -side top    -fill x
  pack .top_left         -in .top     -side left   
  pack .top_right        -in .top     -side right  -fill x -expand yes
  pack .center                        -side left   -fill both -expand yes

  pack .bottom           -in .center  -side bottom -fill x
  pack .bottom1          -in .bottom  -side top    -fill x
  pack .bottom1label     -in .bottom1 -side top    -fill x    -expand yes
  pack .bottom1workspace -in .bottom1 -side bottom -fill both -expand yes
  if {$cvscfg(buttonstyle) == "Text"} {
    pack .bottom2          -in .bottom  -side bottom -fill x
    pack .bottom2label     -in .bottom2 -side top    -fill x    -expand yes
    pack .bottom2workspace -in .bottom2 -side bottom -fill both -expand yes
  }

  pack .cleft            -in .center  -side left   -fill both -expand yes
  pack .cright           -in .center  -side right  -fill both -expand yes
  pack .crbottom         -in .cright  -side bottom -fill both -expand yes    
  pack .clbottom         -in .cleft   -side bottom -fill both -expand yes
    
  #
  # Top section of the screen ("commentary").
  #

  label .lcwd        -text "Current Directory" -anchor w
  label .lmodule     -text "Module Location"   -anchor w
  label .lfilter     -text "Filter:"           -anchor w 
  label .lworkspace  -text "Workspace"         -anchor w
  label .lrepository -text "Repository"        -anchor w

  entry .tcwd     -textvariable cwd         -relief sunken 
  label .tmodule  -textvariable module_dir  -anchor w
  entry .tfilter  -textvariable cvscfg(file_filter) -relief sunken 
  # bind_motifentry .tcwd
  bind .tcwd        <Return> {setup_dir}
  # bind_motifentry .tfilter
  bind .tfilter        <Return> {setup_dir}

  #
  # The central portion of the main screen.  This is where all of the
  # files and their statuses (for CVS 1.3 and later) are listed.
  #
  listbox   .file_list   -yscroll {.scroll set} \
    -relief sunken -width 40 -height $cvscfg(y_size) -setgrid yes \
    -selectmode extended
  listbox   .status_list -yscroll {.scroll set} \
    -relief sunken -width 20 -height $cvscfg(y_size) -setgrid yes
  scrollbar .scroll  -command {workdir_scroll} \
    -relief sunken
        
  # Mouse button bindings need some work; i.e., there should be a richer set.
  bind .file_list   <Double-Button-1> \
    { workdir_act_on_file [workdir_list_files] }
  bind .file_list   <Button-2>        \
    { nop }
  bind .file_list   <ButtonRelease-3> \
    { nop }

  #bind .status_list <Double-Button-1> { workdir_status_of_file %y }
  #bind .status_list <ButtonRelease-1> { workdir_status_list_file %y }
  #bind .status_list <1>               { workdir_status_list_file %y }
  bind .status_list <Double-Button-1> { nop }
  bind .status_list <ButtonRelease-1> { nop }
  bind .status_list <1>               { nop }
  bind .status_list <2>               { nop }
  bind .status_list <Any-B1-Motion>   { nop }
  bind .status_list <Any-B2-Motion>   { nop }
  bind .status_list <Any-B3-Motion>   { nop }
  
  #
  # Packing for the top two sections.
  #
  pack .lcwd     -in .top_left  -side top   -fill x -pady 3
  pack .lmodule  -in .top_left  -side top   -fill x
  pack .tcwd     -in .top_right -side top   -fill x -pady 3
  pack .tmodule  -in .top_right -side top   -fill x -pady 1
  pack .lworkspace .lfilter .tfilter -in .bottom1label -side left 
  pack .lrepository  -in .bottom2label -side left 
    
  pack .file_list                   -in .clbottom  -side left  \
    -fill both    -expand yes
  pack .status_list                 -in .crbottom  -side left  \
    -fill both    -expand yes            
  pack .scroll                      -in .crbottom  -side right \
    -fill y       -expand yes -padx 2 
    
  #
  # Action buttons along the bottom of the screen.
  #
  button .bcheck        -relief raised \
    -command cvs_check
  button .bedit_files   -relief raised \
    -command { workdir_act_on_file [workdir_list_marked_files] }
  button .bdelete_file  -relief raised \
    -command { workdir_delete_file [workdir_list_marked_files] }
  button .bclear        -relief raised \
    -command { .file_list select clear 0 end }
  button .brefresh      -relief raised \
    -command setup_dir
  button .blogfile      -relief raised \
    -command { eval cvs_logcanvas  [workdir_list_marked_files] }
  button .bclean        -relief raised \
    -command workdir_cleanup

  if {$cvscfg(buttonstyle) == "Text"} {
    .bcheck        configure -text "Check"
    .bedit_files   configure -text "Edit"
    .bdelete_file  configure -text "Delete"
    .bclear        configure -text "Clear"
    .brefresh      configure -text "Refresh"
    .blogfile      configure -text "Log Browse"
    .bclean        configure -text "Clean"
  } else {
    .bcheck        configure -bitmap @$local_bitmapdir/check.xbm
    .bedit_files   configure -bitmap @$local_bitmapdir/notebook.xbm
    .bdelete_file  configure -bitmap @$local_bitmapdir/delete.xbm
    .bclear        configure -bitmap @$local_bitmapdir/clear.xbm
    .brefresh      configure -bitmap @$local_bitmapdir/refresh.xbm
    .blogfile      configure -bitmap @$local_bitmapdir/logfile.xbm
    .bclean        configure -bitmap @$local_bitmapdir/clean.xbm
  }

  # Tooltips for the above buttons.

  if !{$TOOLTIPS_OFF} {
    set_tooltips .bedit_files \
      {"Edit the selected files using $cvscfg(editor)"}
    set_tooltips .bdelete_file \
      {{Delete the selected files}}
    set_tooltips .bclear \
      {{Unselect all files}}
    set_tooltips .brefresh \
      {{Re-read the current directory}}
    set_tooltips .blogfile \
      {{See the revision log of the selected files}}
    set_tooltips .bclean \
      {{Remove all backup files from the current directory}}
  }

  button .badd_files    -relief raised \
    -command { cvs_add             [workdir_list_marked_files] }
  button .bremove       -relief raised \
    -command {cvs_remove           [workdir_list_marked_files] }
  button .bdiff         -relief raised \
    -command { eval cvs_diff       [workdir_list_marked_files] } 
  button .bcheckin      -relief raised \
    -command commit_run
  button .bupdate       -relief raised \
    -command { cvs_update       "" [workdir_list_marked_files] }
  button .bmodbrowse    -relief raised \
    -command checkout_run
  button .bimport       -relief raised \
    -command import_run
  button .bquit         -relief raised \
    -command exit
    
  if {$cvscfg(buttonstyle) == "Text"} {
    .badd_files    configure -text "Add"
    .bremove       configure -text "Remove"
    .bcheckin      configure -text "Check In"
    .bupdate       configure -text "Update"
    .bdiff         configure -text "Diff"
    .bmodbrowse    configure -text "Module Browse"
    .bimport       configure -text "Import"
    .bquit         configure -text "Quit"
  } else {
    .badd_files    configure -bitmap @$local_bitmapdir/add.xbm
    .bremove       configure -bitmap @$local_bitmapdir/remove.xbm
    .bcheckin      configure -bitmap @$local_bitmapdir/checkin.xbm
    .bupdate       configure -bitmap @$local_bitmapdir/update.xbm
    .bdiff         configure -bitmap @$local_bitmapdir/diff.xbm
    .bmodbrowse    configure -bitmap @$local_bitmapdir/tree16.xbm
    .bimport       configure -bitmap @$local_bitmapdir/import.xbm
    .bquit         configure -text "Quit"
  }

  # ToolTips popups for the buttons.

  if !{$TOOLTIPS_OFF} {
    set_tooltips .bcheck \
      {{Check the files in the current directory against the repository}}
    set_tooltips .badd_files \
      {{Add the selected files to the repository}}
    set_tooltips .bremove \
      {{Remove the selected files from the repository}}
    set_tooltips .bcheckin \
      {{Check the selected files in to the repository}}
    set_tooltips .bupdate \
      {{Update the selected files from the repository}}
    set_tooltips .bdiff \
      {{See the differences between the selected files and the repository}}
    set_tooltips .bmodbrowse \
      {{Browse the modules in the repository or check out a module}}
    set_tooltips .bimport \
      {{Import the current directory into the repository}}
    set_tooltips .bquit \
      {{Exit from tkCVS}}
  }

  #
  # Pack the buttons.
  #
  if {$cvscfg(buttonstyle) == "Text"} {
    pack .bcheck .bedit_files .bdelete_file .bclear .brefresh .blogfile .bclean \
      -ipadx 2 -ipady 2 -padx 4 -pady 4 \
      -in .bottom1workspace -side left -fill both -expand 1
    pack .badd_files .bremove .bdiff .bcheckin .bupdate \
         .bmodbrowse .bimport .bquit \
      -ipadx 2 -ipady 2 -padx 4 -pady 4 \
      -in .bottom2workspace -side left -fill both -expand 1
  } else {
    pack .bcheck .bedit_files .bdelete_file .bclear .brefresh .blogfile .bclean \
         .badd_files .bremove .bdiff .bcheckin .bupdate \
         .bmodbrowse .bimport \
         -ipadx 1 -ipady 1 -padx 1 -pady 1 \
         -in .bottom1workspace -side left
    pack .bquit \
      -ipadx 2 -ipady 2 -padx 4 -pady 4 \
      -in .bottom1workspace -side right
  }

  #
  # Entry widget to be used for feedback
  #
  set feedback(cvs) [entry .feedback -width 55]
  pack .feedback -in .bottom -side bottom -fill x -expand yes
    
  setup_dir
}

proc workdir_list_marked_files {} {
    return [ workdir_list_files ]
}

proc markedFiles { c } {
  #puts stdout "markedFiles ..."
  set id_list [ $c find withtag selected ]
  set filelist ""

  foreach id $id_list {
    lappend filelist [ getFilename $id $c ]
  }
  #puts stdout "markedFiles ... done"

  return $filelist
}

proc getFilename { id c } {
  global filenamePrefix
  #puts stdout "getFilename ..."
  set taglist [ getTagList $id $c ]
  set tagpos  [ lsearch $taglist $filenamePrefix* ]
  set tag     [ lindex $taglist $tagpos ]
  set filename [lindex [ split $tag $filenamePrefix ] 1 ]
  #puts stdout "Filename prefix is \"$filenamePrefix\""
  #puts stdout "Filename taglist is \"$taglist\""
  #puts stdout "Filename tagpos is \"$tagpos\""
  #puts stdout "Filename tag is \"$tag\""
  #puts stdout "Filename is \"$filename\""
  return $filename
  #puts stdout "getFilename ... done"
}

proc getTagList { id c } {
  #puts stdout "getTagList ..."
  #puts stdout "Taglist is \"[lindex [ $c itemconf $id -tags ] 4 ]\""
  return [lindex [ $c itemconf $id -tags ] 4]
  #puts stdout "getTagList ... done"
}

proc workdir_list_files {} {
  #puts stdout "workdir_list_files ..."
  foreach item [.file_list curselection] {
    if [info exists getlist] {
      lappend getlist [.file_list get $item]
    } else {
      set getlist [.file_list get $item]
    }
  }

  if [info exists getlist] {
    return $getlist
  } else {
    return {}
  }
}

proc workdir_act_on_file {filename} {
  global cvscfg
  global cwd

  feedback_cvs "Building scroll list, please wait!"
  if [file isdirectory $filename] {
    change_dir $filename
  } else {
    set commandline "exec $cvscfg(editor)"
    foreach file $filename {
      if {$cvscfg(editorargs) == {}} {
        exec $cvscfg(editor) $file > /dev/null &
      } else {
        exec $cvscfg(editor) $cvscfg(editorargs) $file > /dev/null &
      }
    }
  }
  feedback_cvs ""
}

proc workdir_status_list_files {} {
    foreach item [.status_list curselection] {
        if [info exists getlist] {
            lappend getlist [.file_list get $item]
        } else {
            set getlist [.file_list get $item]
        }
    }

    if [info exists getlist] {
        set cur_select [.status_list curselection]
        set start_pos [ lindex $cur_select 0 ]
        set end_pos   [ expr [ llength $cur_select ] + $start_pos - 1 ]
        .file_list select set $start_pos $end_pos
        return $getlist
    } else {
        set cur_select [.status_list curselection]
#       cvserror "button pressed: curselection =$cur_select"
        return {}
    }
}

proc workdir_status_list_file {yposition} {
    set cur_select [.status_list nearest $yposition]
    # .file_list select from $cur_select
    # .file_list select to   $cur_select
    return $cur_select
}


proc workdir_status_of_file {yposition} {
#
# Do this when file is double-clicked on
#
  global file_list

  .file_list select set [ .status_list nearest $yposition ]

  set ypos [ .status_list nearest $yposition ]
  set filename [ .file_list get $ypos ]
  if [file isdirectory $filename] {
      change_dir $filename
  } else {
      .status_list insert $ypos [ workdir_status_list_files ]
  }
}

#-------------------------------
#-------------------------------
proc change_dir_rel {new_dir} {
  global cwd

  update_go $new_dir 0
  set cwd $new_dir
  setup_dir
}


#------------------------------------------------------
# Update the "Go" menu for directories we can go to
# new_dir - the directory we're going to
# doPwd   - tells whether the directory path has
#           been specified  1 means relative to cwd
#                           0 means fully path specified
#-------------------------------------------------------
proc update_go {new_dir doPwd} {
  global .menubar.goto.m
  global dirlist
  global maxdirs
  global dirlen
  
  if {$new_dir == "." } { return }
  if {$new_dir == ".."} { return }
  if {$new_dir == "~" } { return }

  # Get full pathname of directory
  if {$doPwd == "1"} {
     set new_dir [format {%s/%s} [pwd] $new_dir ]
  }

  # Check if already in Go list
  set dirlocation  [lsearch -exact $dirlist $new_dir]

  # Move a directory already in the list to the top of the list
  if {$dirlocation != -1} {
    set dirlist [lreplace $dirlist $dirlocation $dirlocation ]
    set dirlist [linsert $dirlist 0 $new_dir]
  } else {
    set dirlist [linsert $dirlist 0 $new_dir]
  }
  set dirlen  [llength $dirlist]

  # Truncate end of directory list if we have too many directories
  if {$dirlen > $maxdirs} {
    set $dirlen [incr dirlen -1]
    set dirlist [lreplace $dirlist $dirlen $dirlen ]
  }
 
  # Destroy old menu selections for "Go"
  destroy .menubar.goto.m
  menu .menubar.goto.m
  .menubar.goto.m add command -label "Home" \
     -command {change_dir ~}

  # Rebuild menu selections for "Go" with new dirlist
  for {set i 0} {$i < $dirlen} {incr i 1} {
    set tmpdir [lindex $dirlist $i]
    .menubar.goto.m add command -label $tmpdir \
      -command [ format {change_dir_rel %s} $tmpdir ]
  }
}

proc change_dir {new_dir} {
  global cwd

  update_go $new_dir 1
  set cwd $new_dir
  setup_dir
}


# I modified this a lot to support the status listbox and marked canvas.
# I cringe at the size of the procedure -- it needs to be broken into smaller 
# ones badly.
# -sj

proc setup_dir {} {
  #
  # Call this when entering a directory.  It puts all of the file names
  # in the listbox, and reads the CVS or CVS.adm directory.
  #
  global cvsroot
  global cwd
  global module_dir
  global incvs
  global cvscfg
    
  #puts stdout "setup_dir: entering procedure."
  .file_list delete 0 end
  .status_list delete 0 end
  set module_dir "Not in the repository"
  set incvs 0

  set unknown_in_repository      "          ????"
  set directory_label            "                      < dir >"
  set up_to_date_with_repository "            ok"
  set locally_lost               " locally lost!"
    
  if [file isdirectory $cwd] {
    cd $cwd
    set cwd [pwd]

    set filelist [ getFiles ]

    set j 0
    foreach i $filelist {
      if { [ isCmDirectory $i ] } {
        if {$i == "CVS"} {
          # New format CVS directory
          read_cvs_dir $cwd/$i
        } elseif {$i == "CVS.adm"} {
          # Old format CVS.adm directory
          read_cvs_adm_dir $cwd/$i
        } else {
          nop
        }
      } else {
        .file_list insert end $i
        #puts stdout "Inserting file($j): $i"
        # count actual number of visible elements (not showing CM directories)
        set j [ expr $j + 1 ]
      }
    }
    cvsroot_check

    if {! $incvs} {
      #puts stdout "setup_dir: not under CVS."
      set module_dir "Not a CVS directory."
      # .status_list configure -background $cvscfg(glb_dir_mark_color)
      # unpack the status listbox and scrollbar from the screen
      pack forget .cright .scroll
      # repack the scrollbar into the file listbox
      pack .scroll -in .clbottom -side right -fill y -expand yes -padx 2
    } elseif { $cvscfg(cvsver) > 1.2 } {
      # make sure the scroll bar is in the right frame
      pack forget .scroll 
      pack .cright -in .center   -side right -fill both -expand yes
      pack .scroll -in .crbottom -side right -fill y -expand yes -padx 2
      # .status_list configure -background $cvscfg(glb_background)
      if { $cvscfg(auto_status) == "true" }  {
        #puts stdout "setup_dir: performing auto status."
        set status_pairs [ cvs_file_status_pairs ] 
        set pair_index 0
        set pair_list_count [ llength $status_pairs ]
        set file_index 0
        set file_list_count [ llength $filelist ]
        while { ( $pair_index < $pair_list_count ) && ( $file_index < $file_list_count ) } {
          #puts stdout "setup_dir: getting next status pair."
          set a_pair [ lindex $status_pairs $pair_index ]
          #puts stdout "Next status pair is $a_pair"
          set sfile [ lindex $a_pair 0 ] 
          set ffile [ lindex $filelist $file_index ]
          #puts stdout "status_pair for file \"$ffile\" is \"$sfile\""
          if { [ isCmDirectory $ffile ] } {
            #puts stdout "setup_dir: found CM directory."
            set file_index [ expr $file_index + 1 ]
          } else {
            if { $ffile == $sfile } {
              #puts stdout "matched! ffile: \"$ffile\"  sfile: \"$sfile\""
              set end_index [ llength $a_pair ]
              set status [ lrange $a_pair 1 $end_index ]
              if { $status != "Up-to-date" } {
                .status_list insert end [ lrange $a_pair 1 $end_index ]
              } else {
                .status_list insert end $up_to_date_with_repository
              }
              set pair_index [ expr $pair_index + 1 ]
              set file_index [ expr $file_index + 1 ]
            } elseif { $ffile < $sfile } {
              #puts stdout "setup_dir: \"$ffile\" not in repository"
              if [file isdirectory $ffile] {
                .status_list insert end $directory_label
              } else {
                .status_list insert end $unknown_in_repository
              }
              set file_index [ expr $file_index + 1 ]
            } else {
              #puts stdout "setup_dir: \"$sfile\" in repository but not in local copy"
              set pair_index [ expr $pair_index + 1 ]
            }
          }
        }
        # process any remaining local files which are not in the CVS repository 
        #puts stdout "setup_dir: pi=$pair_index   plc=$pair_list_count fi=$file_index   flc=$file_list_count"
        if { ( $pair_index == $pair_list_count ) && ( $file_index < $file_list_count ) } {
          for { set i  $file_index } { $i < $file_list_count } { incr i +1} {
            #puts stdout "pi=$pair_index   plc=$pair_list_count fi=$file_index   flc=$file_list_count"
            set ffile [ lindex $filelist $i ]
            if { ! [ isCmDirectory $ffile ] } {
              if [file isdirectory $ffile] {
                #puts stdout "setup_dir: found directory."      
                .status_list insert end $directory_label
              } else {
                #puts stdout "setup_dir: file \"$ffile\" is not in the repository."
                .status_list insert end $unknown_in_repository
              }
            }
          }
        } elseif { ( $pair_index == $pair_list_count ) && ( $file_index == $file_list_count ) } {
          #puts stdout "setup_dir: pair_index == pair_list_count & file_index == file_list_count"
          nop
        } elseif { ( $pair_index < $pair_list_count ) && ( $file_index == $file_list_count ) } {
          #puts stdout "setup_dir: file_index($file_index) == file_count($file_list_count)"
          nop
        } else {
          # shouldn't ever get here
          puts stderr "setup_dir: error in indicies in setup_dir"
        }
      }
    }
  }

  # resize scroll bar
  # set scroll_data [.scroll get]
  # set totalUnits [ lindex $scroll_data 0 ]
  # set windowUnits [ lindex $scroll_data 1 ]
  # set firstUnit [ lindex $scroll_data 2 ]
  # set lastUnit [ lindex $scroll_data 3 ]
  #puts stdout "before scroll: \"[.scroll get]\""
  #puts stdout "before scroll data: $totalUnits $windowUnits $firstUnit $lastUnit"
  #puts stdout "before listbox: \"[.file_list configure]\""

  # .scroll set $j $windowUnits 0 $windowUnits
  # set scroll_data [.scroll get]
  # set totalUnits [ lindex $scroll_data 0 ]
  # set windowUnits [ lindex $scroll_data 1 ]
  # set firstUnit [ lindex $scroll_data 2 ]
  # set lastUnit [ lindex $scroll_data 3 ]
  #puts stdout "after scroll: \"[.scroll get]\""
  #puts stdout "after scroll data: $totalUnits $windowUnits $firstUnit $lastUnit"
  #puts stdout "after listbox: \"[.file_list configure]\""

  #puts stdout "setup_dir: exiting procedure."

}


proc cvs_file_status_pairs {} {
  global incvs
  global cvsver

  #puts stdout "cvs_file_status_pairs: entering function."
  if {! $incvs} {
    cvs_notincvs
    return 1
  }
  # Note:  This needs changing to be backwards compatible with CVS 1.2.
  # It may not be possible, because CVS 1.2 does not have a long format
  # status listing.
  set commandline "exec cvs -q status -l . | "
  set commandline "$commandline awk {\$3 ~ /Status:/ "
  set commandline "$commandline { printf(\"%s %s %s %s %s^\", \$2, \$4, \$5, \$6, \$7 );}}"
  #puts stdout "cvs_file_status_pairs: commandline is \"$commandline\""
  catch { eval $commandline } view_this
  set list_length [ expr [ llength $view_this ] -1]
  set i 0
  set str $view_this
  set rtn_list ""
  while {$i < $list_length } {
    set start_index $i 
    set end_index   [expr [ lsearch -regexp $str {\^} ] - 1 ]
    regsub {\^} $str { } str
    set filename [ lindex $str $i ]
    set status   [ lrange $str [ expr $i + 1 ] $end_index ]
    if { ( $end_index < 0 ) } {
      set i $list_length
    } else {
      set i [ expr $end_index  + 1 ]
    }
    lappend rtn_list [ list $filename $status ]
  }
  #puts stdout "cvs_file_status_pairs: exiting procedure."
  #puts "Return list = $rtn_list"
  return $rtn_list
}

proc read_cvs_adm_dir {dirname} {
#
# Reads an old format CVS.adm directory
#
  global module_dir
  global incvs

  if [file isdirectory $dirname] {
    if [file isfile $dirname/Repository] {
      set module_dir [exec cat $dirname/Repository]
      set incvs 1
    } else {
      cvserror "Repository file not found in $dirname"
    }
  } else {
    cvserror "$dirname is not a directory"
  }
}

proc read_cvs_dir {dirname} {
#
# Reads a new format CVS directory
#
  global module_dir
  global incvs
  global cvscfg

  if [file isdirectory $dirname] {
    if [file isfile $dirname/Repository] {
      set module_dir [exec cat $dirname/Repository]
      if [file isfile $dirname/Root] {
        set cvscfg(admin_dir) [exec cat $dirname/Root]
        set cvscfg(cvsver) 1.4
      }
      set incvs 1
    } else {
      cvserror "Repository file not found in $dirname"
    }
  } else {
    cvserror "$dirname is not a directory"
  }
}

proc workdir_scroll { args } {

# To support scrolling 3 listboxes simultaneously

  #puts "args = $args"
  eval ".file_list     yview $args"
  eval ".status_list   yview $args"

  # set scroll_data [.scroll get]
  # set totalUnits [ lindex $scroll_data 0 ]
  # set windowUnits [ lindex $scroll_data 1 ]
  # set firstUnit [ lindex $scroll_data 2 ]
  # set lastUnit [ lindex $scroll_data 3 ]

  #puts stdout "workdir scroll: scroll: \"[.scroll get]\""
  #puts stdout "workdir scroll: listbox: \"[.file_list configure]\""
}

proc workdir_cleanup {} {
    global cvscfg

    set commandline "$cvscfg(rm_cmd) $cvscfg(clean_these)"
    if { [ are_you_sure "You are about to execute this delete command:\n$commandline" {} ] == 1 } {
        set list [ split $cvscfg(clean_these) " " ]
        set results ""
        foreach item $list {
            if { $item != "" } {
                #puts stdout "cleaning up matches for patterh \"$item\""
                catch { eval exec $cvscfg(rm_cmd) $cvscfg(rm_flags) [ glob $item ] } view_this
                if { $view_this != "" } {
                    set results "$results\n$view_this"
                }
            } else {
                nop
            }
        }
        view_output "Clean" $results
        setup_dir
    }
}

proc workdir_delete_file args {
  global cvscfg

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

  if { [ are_you_sure "This will delete these files:" $args ] == 1 } {
    foreach file $args {
      eval "exec $cvscfg(rm_cmd) $cvscfg(rm_flags) $file "
    }
    setup_dir
  }
}

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

   
   if { $cvscfg(confirm_prompt) != "false" } {
       set mess "$mess\n"
       set indent "      "
       set list [ split [ lindex [ lindex $args 0 ] 0 ] " \t\n" ]
       foreach item $list {
           if { $item != {} } {
               set mess "$mess $indent"
               set val [ lindex $item 0 ]
               set mess "$mess $val\n"
           }
       }
       set mess "$mess\nAre you sure?"
       set confirm [tk_dialog .message {Confirm!} $mess warning 1 OK Quit]
       
       if {$confirm != 0} {
           set confirm [tk_dialog .message {Confirm!} "Aborted at user request." warning 0 OK]
           return 0
       }
   }
   return 1
}


# 
# Sets all cursors to busy, executes command, and restores cursors.
# 
# I believe I got this from GIC. Only some of the functions use it;
# was not immediately clear to me how to get all functions to use it, 
# however.
# -sj
#
proc busy {cmds} {
#    global errorInfo

    set busy {.app}
    set list [winfo children .]
    while {$list != ""} {
        set next {}
        foreach w $list {
            set cursor [lindex [$w config -cursor] 4]
            if {[winfo toplevel $w] == $w || $cursor != ""} {
                lappend busy [list $w $cursor]
            } else {
                lappend busy [list $w {}]
            }
            set next [concat $next [winfo children $w]]
        }
        set list $next
    }

    foreach w $busy {
        catch {[lindex $w 0] config -cursor watch}
    }

    update idletasks

    set error [catch {uplevel eval $cmds} result]
#    set ei $errorInfo

    foreach w $busy {
        catch {[lindex $w 0] config -cursor [lindex $w 1]}
    }

    if $error {
#       error $result $ei
    } else {
        return $result
    }
}


proc workdir_print_file args {
  global cvscfg

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

  set mess "This will print 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 1 OK Quit]

  if {$confirm == 0} {
    foreach file $args {
      exec $cvscfg(print_cmd) $file
    }
  }
}


proc workdir_format_file args {
  global cvscfg

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

  if { [ are_you_sure "This will format these files:" $args ] == 1} {
    foreach file $args {
      exec $cvscfg(format_cmd) $file
    }
    setup_dir
  }
}


proc cvsroot_check {} {
  global cvscfg
  global working_cvsroot
  global incvs
  global env

  if { $incvs } {
    if [file isfile "./CVS/Root"] {
      set f [ open "./CVS/Root" r ]
      gets $f root
      close $f
      set env(CVSROOT) $root
    }
  }
  set working_cvsroot $env(CVSROOT)
}


proc nop {} {}

proc disabled {} {
    set confirm [tk_dialog .message {Confirm!} "Command disabled.." warning 0 OK]
}

proc isCmDirectory { file } {
    switch $file  {
        "CVS"  - 
        "CVS.adm"  - 
        "RCS"  - 
        "SCCS" { set value 1 } 
        default { set value 0 } 
    }
    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

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

    # get the initial file list, including hidden if requested
    if {$cvscfg(allfiles)} {
        # get hidden as well
        foreach item $cvscfg(file_filter) {
            catch { set filelist [ concat [ glob .$item $item ] $filelist ] }
            }
    } else {
        foreach item $cvscfg(file_filter) {
            catch { set filelist [ concat [ glob $item ] $filelist ] }
        }
    }

    # 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 ] }
    }
    #puts stdout "-------------\nfilelist=$filelist\n------------\n"
    return $filelist
}

proc feedback_cvs { message } {
  #######################################################################    
  # This code is adapted from the text "Practical Programming in
  # Tcl and Tk", by Brent B. Welch (see page 209)
  # An entry widget is used because it won't change size
  # base on the message length, and it can be scrolled by
  # dragging with button 2.
  # Author: Eugene Lee, Aerospace Corporation, 9/6/95
  #######################################################################    
  global feedback
  global cvscfg

  set e $feedback(cvs)
  $e config -state normal
  $e delete 0 end
  $e insert 0 $message
  # Leave the entry in a read-only state
  $e config -state disabled

  # Force a disable update
  update idletasks
}
