dialog.tcl

TKCVS Source Code For CVS。

# Set defaults for "Update with Options" dialog
proc update_set_defaults {} {
  global cvsglb

  set cvsglb(tagmode_selection) "Keep"
  set cvsglb(updatename) ""
  set cvsglb(action_notag) "Remove"
  set cvsglb(get_all_dirs) "No"
  set cvsglb(getdirname) ""
  set cvsglb(norm_bin) "Normal"
}

# Do what was setup in the "Update with Options" dialog
proc update_with_options {} {
  global cvsglb

  gen_log:log T "ENTER"

  if { $cvsglb(updatename) == "" } {
    set tagname "BASE"
  } else {
    set tagname $cvsglb(updatename)
  }
  if { $cvsglb(get_all_dirs) == "No" } { set cvsglb(getdirname) "" }
  if { $cvsglb(getdirname) == "" } {
    set dirname " "
  } else {
    set dirname $cvsglb(getdirname)
  }
  #puts "from update_setup, tagname $tagname.  norm_bin $cvsglb(norm_bin)"
  if { $cvsglb(tagmode_selection) == "Keep" } {
    eval "cvs_update {BASE} \
       {$cvsglb(norm_bin)} {$cvsglb(action_notag)} {$cvsglb(get_all_dirs)} \
       {$dirname} [workdir_list_files]"
  } elseif { $cvsglb(tagmode_selection) == "Trunk" } {
    eval "cvs_update {HEAD} \
       {$cvsglb(norm_bin)} {$cvsglb(action_notag)} {$cvsglb(get_all_dirs)} \
       {$dirname} [workdir_list_files]"
  } elseif { $cvsglb(tagmode_selection) == "Getrev" } {
    eval "cvs_update {$tagname} \
       {$cvsglb(norm_bin)} {$cvsglb(action_notag)} {$cvsglb(get_all_dirs)} \
       {$dirname} [workdir_list_files]"
  } else {
    cvsfail "Internal TkCVS error.\ntagmode_selection $cvsglb(tagmode_selection)." \
        .workdir
  }
  gen_log:log T "LEAVE"
}

proc addir_dialog {args} {
  global cvs
  global incvs

  gen_log:log T "ENTER ($args)"
  if {! $incvs} {
    cvs_notincvs
    return 1
  }

  set binflag ""
  toplevel .add
  grab set .add

  set filelist [join $args]
  if {$filelist == ""} {
    set mess "This will add all new directories"
  } else {
    set mess "This will add these directories:\n\n"
    foreach file $filelist {
      append mess "   $file\n"
    }
  }

  message .add.top -justify left -aspect 300 -relief groove \
    -text "Add (recursively) a directory to the module.\
           The repository will not be changed until you do a commit."
  pack .add.top -side top -fill x

  message .add.middle -text $mess -aspect 200
  pack .add.middle -side top -fill x

  checkbutton .add.binary -text "-kb (binary)" \
     -variable binflag -onvalue "-kb" -offvalue ""
  pack .add.binary -side top

  frame .add.down
  button .add.down.add -text "Add" \
    -command {
      grab release .add
      destroy .add
      cvs_add_dir $binflag [workdir_list_files]
    }
  button .add.down.cancel -text "Cancel" \
    -command { grab release .add; destroy .add }
  pack .add.down -side bottom -fill x -expand 1
  pack .add.down.add .add.down.cancel -side left \
    -ipadx 2 -ipady 2 -padx 4 -pady 4 -fill both -expand 1

  wm title .add "Add Directories"
  wm minsize .add 1 1

  gen_log:log T "LEAVE"
}

proc subtractdir_dialog {args} {
  global cvs
  global incvs

  gen_log:log T "ENTER ($args)"
  if {! $incvs} {
    cvs_notincvs
    return 1
  }

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

  toplevel .subtract
  grab set .subtract

  set mess "This will remove these directories:\n\n"
  foreach file $filelist {
    append mess "   $file\n"
  }

  message .subtract.top -justify left -aspect 300 -relief groove \
    -text "Remove (recursively) a directory from the module.  The repository\
           will not be changed until you do a commit."
  pack .subtract.top -side top -fill x

  message .subtract.middle -text $mess -aspect 200
  pack .subtract.middle -side top -fill x
  frame .subtract.down
  button .subtract.down.remove -text "Remove" \
    -command {
      grab release .subtract
      destroy .subtract
      cvs_remove_dir [workdir_list_files]
    }
  button .subtract.down.cancel -text "Cancel" \
    -command { grab release .subtract; destroy .subtract }
  pack .subtract.down -side bottom -fill x -expand 1
  pack .subtract.down.remove .subtract.down.cancel -side left \
    -ipadx 2 -ipady 2 -padx 4 -pady 4 -fill both -expand 1

  wm title .subtract "Remove Directories"
  wm minsize .subtract 1 1

  gen_log:log T "LEAVE"
}

proc file_input_and_do {title cmd} {
  global filename

  gen_log:log T "ENTER ($title $cmd)"

  toplevel .file_input_and_do
  grab set .file_input_and_do

  frame .file_input_and_do.top
  pack .file_input_and_do.top -side top -fill both -expand 1 -pady 4 -padx 4

  label .file_input_and_do.top.lbl -text "File Name" -anchor w
  entry .file_input_and_do.top.entry -relief sunken -textvariable filename
  bind .file_input_and_do.top.entry <Return> \
    { .file_input_and_do.ok invoke }
  pack .file_input_and_do.top.lbl -side left
  pack .file_input_and_do.top.entry -side left -fill x -expand 1

  frame .file_input_and_do.bottom
  pack .file_input_and_do.bottom -side bottom -fill x -pady 4 -padx 4

  button .file_input_and_do.ok -text "Ok" \
    -command "
      .file_input_and_do.close invoke
      $cmd \$filename
    "
  button .file_input_and_do.close -text "Cancel" \
    -command {
      grab release .file_input_and_do
      destroy .file_input_and_do
    }
  pack .file_input_and_do.ok .file_input_and_do.close \
    -in .file_input_and_do.bottom \
    -side left -fill both -expand 1

  wm title .file_input_and_do $title
  wm minsize .file_input_and_do 1 1
  focus .file_input_and_do.top.entry

  gen_log:log T "LEAVE"
}

proc release_dialog { args } {

  gen_log:log T "ENTER ($args)"

  set delflag ""
  toplevel .release
  grab set .release

  set filelist [join $args]
  message .release.top -justify left -aspect 300 -relief groove \
    -text "Tell CVS that the directory is no longer being\
           worked on. CVS will stop tracking it in the\
           CVS history file.  Optionally, delete the directory."
  pack .release.top -side top -fill x
  
  #set mess "This will release these directories:\n\n"
  #foreach file $filelist {
    #append mess "   $file\n"
  #}
  #message .release.middle -text $mess -aspect 200
  #pack .release.middle -side top -fill x

  checkbutton .release.binary -text "delete (-d)" \
     -variable delflag -onvalue "-d" -offvalue ""
  pack .release.binary -side top

  frame .release.down
  button .release.down.release -text "Release" \
    -command {
      grab release .release
      destroy .release
      cvs_release $delflag [workdir_list_files]
    }
  button .release.down.cancel -text "Cancel" \
    -command { grab release .release; destroy .release }
  pack .release.down -side bottom -fill x -expand 1
  pack .release.down.release .release.down.cancel -side left \
    -ipadx 2 -ipady 2 -padx 4 -pady 4 -fill both -expand 1

  wm title .release "Release Directories"
  wm minsize .release 1 1

  gen_log:log T "LEAVE"
}

proc svn_update_options {} {
  global cvsglb
  global cvscfg

  gen_log:log T "ENTER"

  if {[winfo exists .svn_update]} {
    wm deiconify .svn_update
    raise .svn_update
    grab set .svn_update
    gen_log:log T "LEAVE"
    return
  }

  if {! [info exists cvsglb(tagmode_selection)]} {
    set cvsglb(tagmode_selection) "Keep"
  }

  toplevel .svn_update
  grab set .svn_update
  frame .svn_update.explaintop
  frame .svn_update.options
  frame .svn_update.down

  frame .svn_update.options.keep -relief groove -border 2
  frame .svn_update.options.trunk -relief groove -border 2
  frame .svn_update.options.branch -relief groove -border 2
  frame .svn_update.options.revision -relief groove -border 2

  pack .svn_update.down -side bottom -fill x
  pack .svn_update.explaintop -side top -fill x -pady 1
  pack .svn_update.options -side top -fill x -pady 1

  # Provide an explanation of this dialog box
  label .svn_update.explain -relief raised -bd 1 \
    -text "Update files in local directory"

  pack .svn_update.explain \
    -in .svn_update.explaintop -side top -fill x

  pack .svn_update.options.keep -side top -fill x
  pack .svn_update.options.trunk -side top -fill x
  pack .svn_update.options.branch -side top -fill x
  pack .svn_update.options.revision -side top -fill x

  # If the user wants to simply do a normal update
  radiobutton .svn_update.options.keep.select \
    -text "Update to most recent revision on same branch or trunk." \
    -variable cvsglb(tagmode_selection) -value "Keep" -anchor w

  message .svn_update.options.keep.explain -font $cvscfg(listboxfont) \
    -justify left -width 400 \
    -text "If local directory is on main trunk, get latest on main trunk.
If local directory is on a branch, get latest on that branch."

  pack .svn_update.options.keep.select -side top -fill x
  pack .svn_update.options.keep.explain -side top -fill x -pady 1 -ipady 0

  # If the user wants to update to the head revision
  radiobutton .svn_update.options.trunk.select \
    -text "Switch local files to be on main trunk" \
    -variable cvsglb(tagmode_selection) -value "Trunk" -anchor w

  message .svn_update.options.trunk.explain -font $cvscfg(listboxfont) \
    -justify left -width 400 \
    -text "Advice:  If your local directories are currently on a branch, \
you may want to commit any local changes to that branch first."

  pack .svn_update.options.trunk.select -side top -fill x
  pack .svn_update.options.trunk.explain -side top -fill x -pady 1 -ipady 0

  # If the user wants to update to a branch
  radiobutton .svn_update.options.branch.select \
    -text "Switch local files to be on a branch" \
    -variable cvsglb(tagmode_selection) -value "Branch" -anchor w

  frame .svn_update.options.branch.lblentry
  label .svn_update.lbranch -text "Branch" -anchor w
  entry .svn_update.tbranch -relief sunken -textvariable cvsglb(branchname)

  pack .svn_update.options.branch.select -side top -fill x
  pack .svn_update.options.branch.lblentry -side top -fill x \
    -expand y -pady 1 -ipady 0
  pack .svn_update.lbranch -in .svn_update.options.branch.lblentry \
    -side left -fill x -pady 4
  pack .svn_update.tbranch -in .svn_update.options.branch.lblentry \
    -side left -fill x -padx 2 -pady 4

  # Where user enters a revision number
  radiobutton .svn_update.options.revision.select \
    -text "Update (-r) local files to be a specific revision:" \
    -variable cvsglb(tagmode_selection) -value "Revision" -anchor w

  frame .svn_update.options.revision.lblentry
  label .svn_update.lrev -text "Revision" -anchor w
  entry .svn_update.trev -relief sunken -textvariable cvsglb(revnumber)

  pack .svn_update.options.revision.select -side top -fill x
  pack .svn_update.options.revision.lblentry -side top -fill x \
    -expand y -pady 1 -ipady 0
  pack .svn_update.lrev -in .svn_update.options.revision.lblentry \
    -side left -fill x -pady 4
  pack .svn_update.trev -in .svn_update.options.revision.lblentry \
    -side left -fill x -padx 2 -pady 4

  # The OK/Cancel buttons
  button .svn_update.ok -text "OK" \
    -command { grab release .svn_update
               wm withdraw .svn_update              
               svn_opt_update }

  button .svn_update.apply -text "Apply" \
    -command svn_opt_update

  button .svn_update.quit -text "Close" \
    -command { grab release .svn_update
               wm withdraw .svn_update }

  pack .svn_update.ok .svn_update.apply .svn_update.quit -in .svn_update.down \
    -side left -ipadx 2 -ipady 2 -padx 4 -pady 4 -fill both -expand 1

  # Window Manager stuff
  wm title .svn_update "Update from Repository"
  wm minsize .svn_update 1 1
  gen_log:log T "LEAVE"
}