modbrowse.tcl

TKCVS Source Code For CVS。

#
# Set up a check out dialog.
#

proc modbrowse_setup {} {
  global cwd
  global repository_root
  global modbrowse_module
  global modbrowse_path
  global modbrowse_title
  global cvsglb
  global cvscfg
  global tcl_platform

  gen_log:log T "ENTER"
  set cwd [pwd]

  # Window manager stuff.
  toplevel .modbrowse
  wm title .modbrowse "TkCVS Repository Browser"
  wm iconname .modbrowse "TkCVS Repository Browser"
  if {$tcl_platform(platform) != "windows"} {
    wm iconbitmap .modbrowse @$cvscfg(bitmapdir)/tkcvs48.xbm
  }
  wm protocol .modbrowse WM_DELETE_WINDOW {
    .modbrowse.bottom.buttons.closefm.close invoke 
  }
  if {[info exists cvscfg(modgeom)]} {
    wm geometry .modbrowse $cvscfg(modgeom)
  } else {
    wm geometry .modbrowse 510x470
  }

  if {[catch "image type Who"]} {
    modbrowse_images
  }

  modbrowse_menus

  #
  # Top section - module, tags, root
  #
  frame .modbrowse.top -relief groove -border 2
  pack .modbrowse.top -side top -fill x

  label .modbrowse.top.lmcode -text "Module"
  entry .modbrowse.top.tmcode -textvariable modbrowse_module \
    -font $cvscfg(listboxfont) -border 2

  label .modbrowse.top.lroot -text "CVSROOT"
  ::picklist::entry .modbrowse.top.troot cvsglb(root) cvsroot
  ::picklist::bind .modbrowse.top.troot <Return> \
    {if {$repository_root != $cvsglb(root)} {modbrowse_run}}

  button .modbrowse.top.bworkdir -image Workdir -command {workdir_setup}

  label .modbrowse.top.lcwd -text "Current Directory"
  ::picklist::entry .modbrowse.top.tcwd cwd directory
  ::picklist::bind .modbrowse.top.tcwd <Return> \
     {if {[pwd] != $cwd} {module_changedir "$cwd"}}

  grid columnconf .modbrowse.top 1 -weight 1
  grid rowconf .modbrowse.top 3 -weight 1
  grid .modbrowse.top.lroot -column 0 -row 0 -sticky w
  grid .modbrowse.top.troot -column 1 -row 0 -columnspan 2 -padx 4 -sticky ew
  grid .modbrowse.top.lmcode -column 0 -row 1 -sticky w
  grid .modbrowse.top.tmcode -column 1 -row 1 -padx 3 -sticky ew
  grid .modbrowse.top.lcwd -column 0 -row 2 -sticky w
  grid .modbrowse.top.tcwd -column 1 -row 2 -padx 4 -sticky ew
  grid .modbrowse.top.bworkdir -column 2 -row 1 -rowspan 2 -sticky w

  # Pack the bottom before the middle so it doesnt disappear if
  # the window is resized smaller
  frame .modbrowse.bottom -relief groove -border 2 -height 128
  frame .modbrowse.bottom.buttons
  frame .modbrowse.bottom.buttons.cvsfuncs -relief groove -bd 2
  frame .modbrowse.bottom.buttons.svnfuncs -relief groove -bd 2
  frame .modbrowse.bottom.buttons.modfuncs -relief groove -bd 2
  frame .modbrowse.bottom.buttons.closefm -relief groove -bd 2

  pack .modbrowse.bottom -side bottom -fill x
  pack .modbrowse.bottom.buttons -side top -fill x -expand yes
  pack .modbrowse.bottom.buttons.closefm -side right -padx 10
  pack .modbrowse.bottom.buttons.cvsfuncs -side left
  pack .modbrowse.bottom.buttons.svnfuncs -side left -expand yes
  pack .modbrowse.bottom.buttons.modfuncs -side left -expand yes

  #
  # Create buttons
  #
  button .modbrowse.bottom.buttons.modfuncs.filebrowse -image Files \
    -command { browse_files $modbrowse_module }
  button .modbrowse.bottom.buttons.modfuncs.patchsummary -image Patches \
    -command { dialog_cvs_patch $cvscfg(cvsroot) $modbrowse_module 1 }
  button .modbrowse.bottom.buttons.modfuncs.patchfile -image Patchfile \
    -command { dialog_cvs_patch $cvscfg(cvsroot) $modbrowse_module 0 }
  button .modbrowse.bottom.buttons.modfuncs.checkout -image Checkout \
    -command { dialog_cvs_checkout $cvscfg(cvsroot) $modbrowse_module }
  button .modbrowse.bottom.buttons.modfuncs.export -image Export \
    -command { dialog_cvs_export $cvscfg(cvsroot) $modbrowse_module }
  button .modbrowse.bottom.buttons.modfuncs.tag -image Tag \
    -command { rtag_dialog $cvscfg(cvsroot) $modbrowse_module "no" }
  button .modbrowse.bottom.buttons.modfuncs.branchtag -image Branchtag \
    -command { rtag_dialog $cvscfg(cvsroot) $modbrowse_module "yes" }

  button .modbrowse.bottom.buttons.svnfuncs.filecat -image Fileview \
    -command { svn_filecat $cvscfg(svnroot) $modbrowse_path $modbrowse_title}
  button .modbrowse.bottom.buttons.svnfuncs.filelog -image Log \
    -command { svn_filelog $cvscfg(svnroot) $modbrowse_path $modbrowse_title}
  button .modbrowse.bottom.buttons.svnfuncs.remove -image SvnRemove \
    -command { svn_delete $cvscfg(svnroot) $modbrowse_path }

  button .modbrowse.bottom.buttons.cvsfuncs.import -image Import \
     -command { import_run }
  button .modbrowse.bottom.buttons.cvsfuncs.who -image Who \
     -command {cvs_history all $modbrowse_module}
  button .modbrowse.bottom.buttons.cvsfuncs.brefresh  -image Refresh \
     -command { modbrowse_run }

  button .modbrowse.bottom.buttons.closefm.close -text "Close" \
    -command { module_exit; exit_cleanup 0 }

  grid .modbrowse.bottom.buttons.cvsfuncs.brefresh -column 0 -row 0 \
     -ipadx 4 -ipady 4
  grid .modbrowse.bottom.buttons.cvsfuncs.who -column 1 -row 0 \
     -ipadx 4 -ipady 4
  grid .modbrowse.bottom.buttons.cvsfuncs.import -column 2 -row 0 \
     -ipadx 4 -ipady 4

  grid .modbrowse.bottom.buttons.modfuncs.filebrowse -column 0 -row 0 \
     -ipadx 4 -ipady 4
  grid .modbrowse.bottom.buttons.modfuncs.checkout -column 1 -row 0 \
     -ipadx 4 -ipady 4
  grid .modbrowse.bottom.buttons.modfuncs.export -column 2 -row 0 \
     -ipadx 4 -ipady 4
  grid .modbrowse.bottom.buttons.modfuncs.tag -column 3 -row 0 \
     -ipadx 4 -ipady 4
  grid .modbrowse.bottom.buttons.modfuncs.branchtag -column 4 -row 0 \
     -ipadx 4 -ipady 4
  grid .modbrowse.bottom.buttons.modfuncs.patchsummary -column 5 -row 0 \
     -ipadx 4 -ipady 4
  grid .modbrowse.bottom.buttons.modfuncs.patchfile -column 6 -row 0 \
     -ipadx 4 -ipady 4

  grid .modbrowse.bottom.buttons.svnfuncs.filecat -column 0 -row 0 \
     -ipadx 4 -ipady 4
  grid .modbrowse.bottom.buttons.svnfuncs.filelog -column 1 -row 0 \
     -ipadx 4 -ipady 4
  grid .modbrowse.bottom.buttons.svnfuncs.remove -column 2 -row 0 \
     -ipadx 4 -ipady 4

  pack .modbrowse.bottom.buttons.closefm.close \
     -side right -fill both -expand yes

  set_tooltips .modbrowse.bottom.buttons.modfuncs.checkout \
     {"Check out selection from the repository"}
  set_tooltips .modbrowse.bottom.buttons.modfuncs.export \
     {"Export selection from the repository"}
  set_tooltips .modbrowse.bottom.buttons.modfuncs.tag \
     {"Tag all files in a module"}
  set_tooltips .modbrowse.bottom.buttons.modfuncs.branchtag \
     {"Branch all files in a module"}
  set_tooltips .modbrowse.bottom.buttons.modfuncs.filebrowse \
     {"Browse the files in a CVS module"}
  set_tooltips .modbrowse.bottom.buttons.svnfuncs.filecat \
     {"Show a file in the SVN repository"}
  set_tooltips .modbrowse.bottom.buttons.svnfuncs.filelog \
     {"Show the history log of a file in the SVN repository"}
  set_tooltips .modbrowse.bottom.buttons.svnfuncs.remove \
     {"Remove something from the SVN repository"}
  set_tooltips .modbrowse.bottom.buttons.modfuncs.patchsummary \
     {"Show a summary of differences between versions"}
  set_tooltips .modbrowse.bottom.buttons.modfuncs.patchfile \
     {"Create a patch file"}
  set_tooltips .modbrowse.bottom.buttons.cvsfuncs.import \
     {"Import the current directory into the repository"}
  set_tooltips .modbrowse.bottom.buttons.cvsfuncs.who \
     {"Show who has modules checked out"}
  set_tooltips .modbrowse.bottom.buttons.cvsfuncs.brefresh \
     {"Re-read the modules"}
  set_tooltips .modbrowse.bottom.buttons.closefm.close \
     {"Close the repository browser"}

  set_tooltips .modbrowse.top.bworkdir \
    {"Open the Working Directory Browser"}

  frame .modbrowse.treeframe
  pack .modbrowse.treeframe -side bottom -fill both -expand yes -pady 0

  set screenWidth [winfo vrootwidth .]
  set screenHeight [winfo vrootheight .]

  wm maxsize .modbrowse $screenWidth $screenHeight
  wm minsize .modbrowse 430 300

  gen_log:log T "LEAVE"
}

proc modbrowse_images {} {
  global cvscfg

  image create photo Workdir \
    -format gif -file [file join $cvscfg(bitmapdir) folderopen.gif]
  image create photo Files \
    -format gif -file [file join $cvscfg(bitmapdir) files.gif]
  image create photo Patches \
    -format gif -file [file join $cvscfg(bitmapdir) rdiff.gif]
  image create photo Patchfile \
    -format gif -file [file join $cvscfg(bitmapdir) patchfile.gif]
  image create photo Who \
    -format gif -file [file join $cvscfg(bitmapdir) who.gif]
  image create photo SvnRemove \
    -format gif -file [file join $cvscfg(bitmapdir) delete_red.gif]
  if {[catch "image type arr_dn"]} {
    workdir_images
  }
}

proc modbrowse_menus {} {
  global cvscfg
  global cvs
  global logclass

  gen_log:log T "ENTER"

  menu .modbrowse.modmenu
  .modbrowse configure -menu .modbrowse.modmenu

  #
  # Create the Menu bar
  #
  .modbrowse.modmenu add cascade -menu .modbrowse.modmenu.file -label "File" -underline 0
  menu .modbrowse.modmenu.file -tearoff 0
  .modbrowse.modmenu add cascade -menu .modbrowse.modmenu.cvs -label "CVS" -underline 0
  menu .modbrowse.modmenu.cvs -tearoff 0
  .modbrowse.modmenu add cascade -menu .modbrowse.modmenu.svn -label "SVN" -underline 0
  menu .modbrowse.modmenu.svn -tearoff 0
  .modbrowse.modmenu add cascade -menu .modbrowse.modmenu.options -label "Options" -underline 0
  menu .modbrowse.modmenu.options -tearoff 0

  #
  # Create the menus
  #
  set selcolor [option get .modbrowse selectColor selectColor]
  .modbrowse.modmenu.file add command -label "Browse Working Directory" -underline 0 \
     -command workdir_setup
  .modbrowse.modmenu.file add separator
  .modbrowse.modmenu.file add command -label "Close" -underline 1 \
     -command {.modbrowse.bottom.buttons.closefm.close invoke}
  .modbrowse.modmenu.file add command -label "Exit" -underline 1 \
     -command { module_exit; exit_cleanup 1 }

  .modbrowse.modmenu.cvs add command -label "CVS Checkout" \
      -command { dialog_cvs_checkout $cvscfg(cvsroot) $modbrowse_module}
  .modbrowse.modmenu.cvs add command -label "CVS Export" \
      -command { dialog_cvs_export $cvscfg(cvsroot) $modbrowse_module}
  .modbrowse.modmenu.cvs add command -label "Tag Module" -underline 0 \
     -command { rtag_dialog $cvscfg(cvsroot) $modbrowse_module "no" }
  .modbrowse.modmenu.cvs add command -label "Branch Tag Module" -underline 0 \
     -command { rtag_dialog $cvscfg(cvsroot) $modbrowse_module "yes" }
  .modbrowse.modmenu.cvs add command -label "Make Patch File" -underline 0 \
     -command { dialog_cvs_patch $cvscfg(cvsroot) $modbrowse_module 0 }
  .modbrowse.modmenu.cvs add command -label "View Patch Summary" -underline 0 \
     -command { dialog_cvs_patch $cvscfg(cvsroot) $modbrowse_module 1 }
  .modbrowse.modmenu.cvs add separator
  .modbrowse.modmenu.cvs add command -label "Import CWD to A New Module" -underline 0 \
     -command { import_run }
  .modbrowse.modmenu.cvs add command -label "Import CWD to An Existing Module" -underline 0 \
     -command { import2_run }
  .modbrowse.modmenu.cvs add command -label "Vendor Merge" -underline 0 \
     -command {merge_run $modbrowse_module}
  .modbrowse.modmenu.cvs add separator
  .modbrowse.modmenu.cvs add command -label "Show My Checkouts" -underline 0 \
     -command {cvs_history me ""}
  .modbrowse.modmenu.cvs add command -label "Show Checkouts of Selected Module" -underline 0 \
     -command {cvs_history all $modbrowse_module}
  .modbrowse.modmenu.cvs add command -label "Show All Checkouts" -underline 0 \
     -command {cvs_history all ""}

  .modbrowse.modmenu.svn add command -label "SVN Checkout" \
      -command { dialog_svn_checkout $cvscfg(svnroot) $modbrowse_path checkout}
  .modbrowse.modmenu.svn add command -label "SVN Export" \
      -command { dialog_svn_checkout $cvscfg(svnroot) $modbrowse_path export}
  .modbrowse.modmenu.svn add command -label "Tag Module" -underline 0 \
     -command { dialog_svn_copy $cvscfg(svnroot) $modbrowse_path "tags" }
  .modbrowse.modmenu.svn add command -label "Branch Module" -underline 0 \
     -command { dialog_svn_copy $cvscfg(svnroot) $modbrowse_path "branches" }
  .modbrowse.modmenu.svn add command -label "Make Patch File" -underline 0 \
     -command { dialog_svn_patch $cvscfg(cvsroot) $modbrowse_path $selB_path 0 }
  .modbrowse.modmenu.svn add command -label "View Patch Summary" -underline 0 \
     -command { dialog_svn_patch $cvscfg(cvsroot) $modbrowse_path $selB_path 1 }
  .modbrowse.modmenu.svn add separator
  .modbrowse.modmenu.svn add command -label "Import CWD into Repository" \
     -command svn_import_run

  .modbrowse.modmenu.options add checkbutton -label "Group Aliases in a Folder (CVS)" \
     -variable cvscfg(aliasfolder) -onvalue true -offvalue false \
     -selectcolor $selcolor -command {
        ModTree:delitem .modbrowse.treeframe /
        ModTree:destroy .modbrowse.treeframe
        busy_start .modbrowse
        ModTree:create .modbrowse.treeframe
        pack .modbrowse.treeframe.pw -side bottom -fill both -expand yes
        modbrowse_tree [lsort [array names modval]] "/"
     }
  .modbrowse.modmenu.options add separator
  .modbrowse.modmenu.options add checkbutton -label "Tracing On/Off" \
     -variable cvscfg(logging) -onvalue true -offvalue false \
     -selectcolor $selcolor -command log_toggle
  .modbrowse.modmenu.options add cascade -label "Trace Level" \
     -menu .modbrowse.modmenu.options.loglevel
  menu .modbrowse.modmenu.options.loglevel
  .modbrowse.modmenu.options.loglevel add checkbutton -label "CVS commands (C)" \
     -variable logclass(C) -onvalue "C" -offvalue "" \
     -selectcolor $selcolor -command gen_log:changeclass
  .modbrowse.modmenu.options.loglevel add checkbutton -label "CVS stderr (E)" \
     -variable logclass(E) -onvalue "E" -offvalue "" \
     -selectcolor $selcolor -command gen_log:changeclass
  .modbrowse.modmenu.options.loglevel add checkbutton -label "File creation/deletion (F)"\
     -variable logclass(F) -onvalue "F" -offvalue "" \
     -selectcolor $selcolor -command gen_log:changeclass
  .modbrowse.modmenu.options.loglevel add checkbutton -label "Function entry/exit (T)" \
     -variable logclass(T) -onvalue "T" -offvalue "" \
     -selectcolor $selcolor -command gen_log:changeclass
  .modbrowse.modmenu.options.loglevel add checkbutton -label "Debugging (D)" \
     -variable logclass(D) -onvalue "D" -offvalue "" \
     -selectcolor $selcolor -command gen_log:changeclass


  menu_std_help .modbrowse.modmenu

  gen_log:log T "LEAVE"
}

proc modbrowse_run { {CVSorSVN {}} } {
  global env
  global svnurl
  global insvn incvs inrcs
  global modval
  global cvscfg
  global cvsglb
  global cvs
  global cmd
  global repository_root

  gen_log:log T "ENTER ($CVSorSVN)"
  # If a checkout is already running, abort it
  if {[info exists cmd(cvs_co)]} {
    catch {$cmd(cvs_co)\::abort}
    catch {unset cmd(cvs_co)}
  }

  catch {unset modval}
  catch {unset modtitle}

  set modbrowse_module ""

  if {! [winfo exists .modbrowse]} {
    modbrowse_setup
  }

  wm deiconify .modbrowse
  raise .modbrowse