workdir.tcl

TKCVS Source Code For CVS。

    gen_log:log T "Adding user defined menu"
  }
  .workdir.menubar add cascade -label "Go" -menu .workdir.menubar.goto -underline 0
  menu .workdir.menubar.goto -tearoff 0

  menu_std_help .workdir.menubar

  #
  # Create the Menus
  #

  # File
  .workdir.menubar.file add command -label "Open Selection" -underline 0 \
     -command { workdir_edit_file [workdir_list_files] }
  .workdir.menubar.file add command -label "Print Selected File" -underline 0 \
     -command { workdir_print_file  [workdir_list_files ] }
  .workdir.menubar.file add command -label "Make New Directory" -underline 0 \
     -command { file_input_and_do "New Directory" workdir_newdir}
  .workdir.menubar.file add separator
  .workdir.menubar.file add command -label "Browse Modules" -underline 0 \
     -command modbrowse_run
  .workdir.menubar.file add command -label "Cleanup Directory" -underline 4 \
     -command workdir_cleanup
  .workdir.menubar.file add separator
  .workdir.menubar.file add command -label "Shell window" -underline 0 \
     -command {eval exec $cvscfg(shell) >& $cvscfg(null) &}
  .workdir.menubar.file add separator
  .workdir.menubar.file add command -label Close -underline 1 \
     -command {.workdir.close invoke}
  .workdir.menubar.file add command -label Exit -underline 1 \
     -command { exit_cleanup 1 }

  # CVS
  .workdir.menubar.cvs add command -label "Update" -underline 0 \
     -command { \
        cvs_update {BASE} {Normal} {Remove} {No} { } [workdir_list_files] }
  .workdir.menubar.cvs add command -label "Update with Options" -underline 7 \
     -command update_run
  .workdir.menubar.cvs add command -label "Commit/Checkin" -underline 0 \
     -command cvs_commit_dialog
  .workdir.menubar.cvs add command -label "Add Files" -underline 0 \
     -command { add_dialog [workdir_list_files] }
  .workdir.menubar.cvs add command -label "Add Recursively" \
     -command { addir_dialog [workdir_list_files] }
  .workdir.menubar.cvs add command -label "Remove Files" -underline 0 \
     -command { subtract_dialog [workdir_list_files] }
  .workdir.menubar.cvs add command -label "Remove Recursively" \
     -command { subtractdir_dialog [workdir_list_files] }
  .workdir.menubar.cvs add command -label "Set Binary Flag" \
     -command { cvs_binary [workdir_list_files] }
  .workdir.menubar.cvs add command -label "Unset Binary Flag" \
     -command { cvs_ascii [workdir_list_files] }
  .workdir.menubar.cvs add command -label "Set Edit Flag (Edit)" -underline 15 \
     -command { cvs_edit [workdir_list_files] }
  .workdir.menubar.cvs add command -label "Unset Edit Flag (Unedit)" -underline 11 \
     -command { cvs_unedit [workdir_list_files] }
  .workdir.menubar.cvs add command -label "Tag Files" -underline 0 \
     -command { file_tag_dialog "no" }
  .workdir.menubar.cvs add command -label "Browse the Log Diagram" \
     -command { cvs_branches [workdir_list_files] }
  .workdir.menubar.cvs add command -label "Resolve Conflicts" \
     -command { cvs_merge_conflict [workdir_list_files] }
  .workdir.menubar.cvs add separator
  .workdir.menubar.cvs add command -label "Release" \
     -command { release_dialog [workdir_list_files] }
  .workdir.menubar.cvs add command -label "Join (Merge) Directory" \
     -underline 0 -command { cvs_directory_merge }
  .workdir.menubar.cvs add command -label "Import CWD into Repository" \
     -underline 0 -command import_run

  # SVN
  .workdir.menubar.svn add command -label "Update" -underline 0 \
     -command {svn_update [workdir_list_files]}
  .workdir.menubar.svn add command -label "Commit/Checkin" -underline 0 \
     -command svn_commit_dialog
  .workdir.menubar.svn add command -label "Add Files" -underline 0 \
     -command { add_dialog [workdir_list_files] }
  .workdir.menubar.svn add command -label "Remove Files" -underline 0 \
     -command { subtract_dialog [workdir_list_files] }
  .workdir.menubar.svn add command -label "Browse the Log Diagram" \
     -command { svn_branches [pwd] [workdir_list_files] }
  .workdir.menubar.svn add separator
  .workdir.menubar.svn add command -label "Import CWD into Repository" \
     -underline 0 -command svn_import_run

  # RCS
  .workdir.menubar.rcs add command -label "Checkout" -underline 0 \
     -command { rcs_checkout [workdir_list_files] }
  .workdir.menubar.rcs add command -label "Checkin" -underline 0 \
     -command { rcs_checkin [workdir_list_files] }
  .workdir.menubar.rcs add command -label "Browse the Log Diagram" \
     -command { rcs_branches [workdir_list_files] }

  # These commands will vary according to revision system.  Does it still make sense to
  # keep them in their own menu?
  .workdir.menubar.reports add command -label "Check Directory" -underline 0
  .workdir.menubar.reports add command -label "Status" -underline 0
  .workdir.menubar.reports add command -label "Log" -underline 0
  .workdir.menubar.reports add command -label "Annotate/Blame" -underline 0

  set selcolor [option get .workdir selectColor selectColor]
  .workdir.menubar.options add checkbutton -label "Show hidden files" \
     -variable cvscfg(allfiles) -onvalue true -offvalue false \
     -selectcolor $selcolor -command setup_dir
  .workdir.menubar.options add checkbutton -label "Automatic directory status" \
     -variable cvscfg(auto_status) -onvalue true -offvalue false \
     -selectcolor $selcolor
  .workdir.menubar.options add checkbutton -label "Confirmation Dialogs" \
     -variable cvscfg(confirm_prompt) -onvalue true -offvalue false \
     -selectcolor $selcolor
  .workdir.menubar.options add separator
  .workdir.menubar.options add checkbutton -label "Editor/Author/Locker Column" \
     -variable cvscfg(showeditcol) -onvalue true -offvalue false \
     -selectcolor $selcolor \
     -command { if {($incvs || $insvn || $inrcs) && $cvscfg(showeditcol)} {
                  DirCanvas:map_column .workdir.main editcol
                } else {
                  pack forget .workdir.main.editcol
                }
              }
  .workdir.menubar.options add checkbutton -label "Status Column" \
     -variable cvscfg(showstatcol) -onvalue true -offvalue false \
     -selectcolor $selcolor \
     -command { if {($incvs || $insvn || $inrcs) && $cvscfg(showstatcol)} {
                  DirCanvas:map_column .workdir.main statcol
                } else {
                  pack forget .workdir.main.statcol
                }
              }
  .workdir.menubar.options add checkbutton -label "Date Column" \
     -variable cvscfg(showdatecol) -onvalue true -offvalue false \
     -selectcolor $selcolor \
     -command { if {$cvscfg(showdatecol)} {
                  DirCanvas:map_column .workdir.main datecol
                } else {
                  pack forget .workdir.main.datecol
                }
              }
  .workdir.menubar.options add separator
  .workdir.menubar.options add checkbutton -label "Report->Check Shows Unknown Files" \
     -variable cvscfg(status_filter) -onvalue false -offvalue true \
     -selectcolor $selcolor
  .workdir.menubar.options add checkbutton -label "Report->Check/Status are Recursive" \
     -variable cvscfg(recurse) -onvalue true -offvalue false \
     -selectcolor $selcolor
  .workdir.menubar.options add cascade -label "CVS Status Detail" \
     -menu .workdir.menubar.options.report_detail
  .workdir.menubar.options add cascade -label "CVS Log Detail" \
     -menu .workdir.menubar.options.logfile_detail
  .workdir.menubar.options add separator
  .workdir.menubar.options add checkbutton -label "Tracing On/Off" \
     -variable cvscfg(logging) -onvalue true -offvalue false \
     -selectcolor $selcolor -command log_toggle
  .workdir.menubar.options add cascade -label "Trace Level" \
     -menu .workdir.menubar.options.loglevel
  .workdir.menubar.options add separator
  .workdir.menubar.options add command -label "Save Options" -underline 0 \
     -command save_options

  menu .workdir.menubar.options.loglevel
  .workdir.menubar.options.loglevel add checkbutton -label "CVS commands (C)" \
     -variable logclass(C) -onvalue "C" -offvalue "" \
     -selectcolor $selcolor -command gen_log:changeclass
  .workdir.menubar.options.loglevel add checkbutton -label "CVS stderr (E)" \
     -variable logclass(E) -onvalue "E" -offvalue "" \
     -selectcolor $selcolor -command gen_log:changeclass
  .workdir.menubar.options.loglevel add checkbutton -label "File creation/deletion (F)"\
     -variable logclass(F) -onvalue "F" -offvalue "" \
     -selectcolor $selcolor -command gen_log:changeclass
  .workdir.menubar.options.loglevel add checkbutton -label "Function entry/exit (T)" \
     -variable logclass(T) -onvalue "T" -offvalue "" \
     -selectcolor $selcolor -command gen_log:changeclass
  .workdir.menubar.options.loglevel add checkbutton -label "Debugging (D)" \
     -variable logclass(D) -onvalue "D" -offvalue "" \
     -selectcolor $selcolor -command gen_log:changeclass

  menu .workdir.menubar.options.report_detail
  .workdir.menubar.options.report_detail add radiobutton -label "Verbose" \
     -variable cvscfg(rdetail) -value "verbose" -selectcolor $selcolor
  .workdir.menubar.options.report_detail add radiobutton -label "Summary" \
     -variable cvscfg(rdetail) -value "summary" -selectcolor $selcolor
  .workdir.menubar.options.report_detail add radiobutton -label "Terse" \
     -variable cvscfg(rdetail) -value "terse" -selectcolor $selcolor

  menu .workdir.menubar.options.logfile_detail
  .workdir.menubar.options.logfile_detail add radiobutton -label "Summary" \
     -variable cvscfg(ldetail) -value "summary" -selectcolor $selcolor
  .workdir.menubar.options.logfile_detail add radiobutton -label "Latest" \
     -variable cvscfg(ldetail) -value "latest" -selectcolor $selcolor
  .workdir.menubar.options.logfile_detail add radiobutton -label "Verbose" \
     -variable cvscfg(ldetail) -value "verbose" -selectcolor $selcolor

  .workdir.menubar.goto add command -label "Go Home" \
     -command {change_dir $cvscfg(home)}
  .workdir.menubar.goto add command -label "Add Bookmark" \
     -command add_bookmark
  .workdir.menubar.goto add command -label "Delete Bookmark" \
     -command delete_bookmark_dialog
  .workdir.menubar.goto add separator
  foreach mark [lsort [array names bookmarks]] {
    # Backward compatibility.  Value used to be a placeholder, is now a revsystem type
    if {$bookmarks($mark) == "t"} {set bookmarks($mark) ""}
    .workdir.menubar.goto add command -label "$mark $bookmarks($mark)" \
       -command "change_dir \"$mark\""
  }


  #
  # Add user commands to the menu.
  #
  if {[info exists cvsmenu]} {
    foreach item [array names cvsmenu] {
      .workdir.menubar.user add command -label $item \
         -command "eval cvs_usercmd $cvsmenu($item) \[workdir_list_files\]"
    }
  }
  if {[info exists usermenu]} {
    .workdir.menubar.user add separator
    foreach item [array names usermenu] {
      .workdir.menubar.user add command -label $item \
         -command "eval cvs_catchcmd $usermenu($item) \[workdir_list_files\]"
    }
  }
  if {[info exists execmenu]} {
    .workdir.menubar.user add separator
    foreach item [array names execmenu] {
      .workdir.menubar.user add command -label $item \
         -command "eval cvs_execcmd $execmenu($item) \[workdir_list_files\]"
    }
  }
  gen_log:log T "LEAVE"
}

proc workdir_list_files {} {
  global cvscfg
  global cvsglb

  gen_log:log T "ENTER (cvsglb(current_selection) = $cvsglb(current_selection))"

  for {set i 0} {$i < [llength $cvsglb(current_selection)]} {incr i} {
    set item [lindex $cvsglb(current_selection) $i]
    regsub {^no file } $item "" item
    # regsub here causes file isfile to return 0.  You have to do it in each
    # proc, just before the cvs command, after file tests have been done.
    #regsub -all {\$} $item {\$} item
    set cvsglb(current_selection) [lreplace $cvsglb(current_selection) $i $i $item]
  }
  gen_log:log T "LEAVE -- ($cvsglb(current_selection))"
  return $cvsglb(current_selection)
}

proc workdir_edit_command {file} {
  global cvscfg

  gen_log:log T "ENTER ($file)"
  if {[info exists cvscfg(editors)]} {
    foreach {editor pattern} $cvscfg(editors) {
      if {[string match $pattern $file]} {
        return "$editor \"$file\""
      }
    }
  }
  return "\"$cvscfg(editor)\" $cvscfg(editorargs) \"$file\""
}

proc workdir_newdir {file} {
  global cvscfg

  gen_log:log T "ENTER ($file)"

  file mkdir $file

  if {$cvscfg(auto_status)} {
    setup_dir
  }

  gen_log:log T "LEAVE"
}

proc workdir_edit_file {args} {
  global cvscfg
  global cwd

  gen_log:log T "ENTER ($args)"

  set filelist [join $args]
  if {$filelist == ""} {
    file_input_and_do "Edit File" workdir_edit_file
    return
  }

  gen_log:log D "$filelist"
  foreach file $filelist {
    if {[file isdirectory $file]} {
      change_dir "$file"
    } else {
      if {![file exists $file] || [file isfile $file]} {
        # If the file doesn't exist it's tempting to touch the file and
        # trigger a reread, but is an empty file of this type valid?
        regsub -all {\$} $file {\$} file
        set commandline "[workdir_edit_command $file] >& $cvscfg(null) &"
        gen_log:log C "$commandline"
        eval "exec $commandline"
      } else {
        cvsfail "$file is not a plain file" .workdir
      }
    }
  }
  gen_log:log T "LEAVE"
}

proc workdir_view_file {args} {
  global cvscfg
  global cwd

  gen_log:log T "ENTER ($args)"

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

  gen_log:log D "$filelist"
  foreach file $filelist {
    set filelog ""
    if {[file isfile $file]} {
      #regsub -all {\$} $file {\$} file
      gen_log:log F "OPEN $file"
      set f [open $file]
      while { [eof $f] == 0 } {
        append filelog [gets $f]
        append filelog "\n"
      }
      view_output::new "$file" $filelog
    } else {
      cvsfail "$file is not a plain file" .workdir
    }
  }
  gen_log:log T "LEAVE"
}

# Let the user mark directories they visit often
proc add_bookmark { } {
  global incvs inrcs insvn
  global bookmarks

  gen_log:log T "ENTER"
  set dir [pwd]
  regsub -all {\$} $dir {\$} dir

  gen_log:log D "directory $dir"
  foreach mark [array names bookmarks] {
    gen_log:log D "  $mark \"$bookmarks($mark)\""
  }

  if {[info exists bookmarks($dir)]} {
    .workdir.menubar.goto delete "$dir $bookmarks($dir)"
  }
  set rtype ""
  if {$inrcs} {
    set rtype "(RCS)"
  } elseif {$incvs} {
    set rtype "(CVS)"
  } elseif {$insvn} {
    set rtype "(SVN)"
  }
  set bookmarks($dir) $rtype
  .workdir.menubar.goto add command -label "$dir $rtype" \
     -command "change_dir \"$dir\""

  gen_log:log T "LEAVE"
}

# A listbox to choose a bookmark to delete
proc delete_bookmark_dialog { } {
   global cvscfg
   global bookmarks

   gen_log:log T "ENTER"
   set maxlbl 0
   foreach mark [array names bookmarks] {
   gen_log:log D "  $mark $bookmarks($mark)"
     set len [string length "$mark $bookmarks($mark)"]
     if {$len > $maxlbl} {
        set maxlbl $len
     }
   }

   set wname .workdir.bookmarkedit
   toplevel $wname
   grab set $wname
   wm title $wname "Delete Bookmarks"
   listbox $wname.lbx -selectmode multiple \
     -font $cvscfg(listboxfont) -width $maxlbl
   pack $wname.lbx -ipadx 10 -ipady 10 -expand y -fill both
   foreach mark [lsort [array names bookmarks]] {
     $wname.lbx insert end "$mark $bookmarks($mark)"
   }
   frame $wname.buttons
   pack $wname.buttons -side top -fill x
   button $wname.delete -text "Delete" \
     -command "delete_bookmark $wname"
        
   button $wname.close -text "Done" \
     -command "
       grab release $wname
       destroy $wname
       exit_cleanup 0"
   pack $wname.delete $wname.close -in $wname.buttons \
     -side right -ipadx 2 -ipady 2 -padx 4 -pady 4 \
     -expand y

   gen_log:log T "LEAVE"
}

# Do the actual deletion of the bookmark
proc delete_bookmark {w} {
  global bookmarks